home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gnu / adainc / a-stwifi.adb < prev    next >
Text File  |  1996-01-30  |  15KB  |  530 lines

  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --               A D A . S T R I N G S . W I D E _ F I X E D                --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.8 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. --  Note: This code is derived from the ADAR.CSH public domain Ada 83
  27. --  versions of the Appendix C string handling packages. One change is
  28. --  to avoid the use of Is_In, so that we are not dependent on inlining.
  29. --  Note that the search function implementations are to be found in the
  30. --  auxiliary package Ada.Strings.Wide_Search. Also the Move procedure is
  31. --  directly incorporated (ADAR used a subunit for this procedure)
  32.  
  33. with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
  34.  
  35. package body Ada.Strings.Wide_Fixed is
  36.  
  37.    ---------
  38.    -- "*" --
  39.    ---------
  40.  
  41.    function "*" (Left  : in Natural;
  42.                  Right : in Wide_Character) return Wide_String
  43.    is
  44.       Result : Wide_String (1 .. Left);
  45.  
  46.    begin
  47.       for I in Result'Range loop
  48.          Result (I) := Right;
  49.       end loop;
  50.  
  51.       return Result;
  52.    end "*";
  53.  
  54.    function "*"
  55.      (Left  : in Natural;
  56.       Right : in Wide_String)
  57.       return  Wide_String
  58.    is
  59.       Result : Wide_String (1 .. Left * Right'Length);
  60.       Ptr    : Integer := 1;
  61.  
  62.    begin
  63.       for J in 1 .. Left loop
  64.          Result (Ptr .. Ptr + Right'Length - 1) := Right;
  65.          Ptr := Ptr + Right'Length;
  66.       end loop;
  67.  
  68.       return Result;
  69.    end "*";
  70.  
  71.    ------------
  72.    -- Delete --
  73.    ------------
  74.  
  75.    function Delete
  76.      (Source  : in Wide_String;
  77.       From    : in Positive;
  78.       Through : in Natural)
  79.       return    Wide_String
  80.    is
  81.       Result : Wide_String
  82.                  (1 .. Source'Length - Natural'Max (Through - From + 1, 0));
  83.  
  84.    begin
  85.       if From not in Source'Range or else Through > Source'Last then
  86.          raise Index_Error;
  87.       end if;
  88.  
  89.       Result := Source (Source'First .. From - 1) &
  90.                 Source (Through + 1 .. Source'Last);
  91.       return Result;
  92.    end Delete;
  93.  
  94.    procedure Delete
  95.      (Source  : in out Wide_String;
  96.       From    : in Positive;
  97.       Through : in Natural;
  98.       Justify : in Alignment := Left;
  99.       Pad     : in Wide_Character := Wide_Fixed.Pad)
  100.    is
  101.    begin
  102.       Move (Source  => Delete (Source, From, Through),
  103.             Target  => Source,
  104.             Justify => Justify,
  105.             Pad     => Pad);
  106.    end Delete;
  107.  
  108.    ----------
  109.    -- Head --
  110.    ----------
  111.  
  112.    function Head
  113.      (Source : in Wide_String;
  114.       Count  : in Natural;
  115.       Pad    : in Wide_Character := Wide_Fixed.Pad)
  116.       return   Wide_String
  117.    is
  118.       Result : Wide_String (1 .. Count);
  119.  
  120.    begin
  121.       if Count < Source'Length then
  122.          Result := Source (Source'First .. Source'First + Count - 1);
  123.  
  124.       else
  125.          Result (1 .. Source'Length) := Source;
  126.  
  127.          for I in Source'Length + 1 .. Count loop
  128.             Result (I) := Pad;
  129.          end loop;
  130.       end if;
  131.  
  132.       return Result;
  133.    end Head;
  134.  
  135.    ------------
  136.    -- Insert --
  137.    ------------
  138.  
  139.    function Insert
  140.      (Source   : in Wide_String;
  141.       Before   : in Positive;
  142.       New_Item : in Wide_String)
  143.       return     Wide_String
  144.    is
  145.       Result : Wide_String (1 .. Source'Length + New_Item'Length);
  146.  
  147.    begin
  148.       if Before < Source'First or else Before > Source'Last + 1 then
  149.          raise Index_Error;
  150.       end if;
  151.  
  152.       Result := Source (Source'First .. Before - 1) & New_Item &
  153.                 Source (Before .. Source'Last);
  154.       return Result;
  155.    end Insert;
  156.  
  157.    procedure Insert
  158.      (Source   : in out Wide_String;
  159.       Before   : in Positive;
  160.       New_Item : in Wide_String;
  161.       Drop     : in Truncation := Error)
  162.    is
  163.    begin
  164.       Move (Source => Insert (Source, Before, New_Item),
  165.             Target => Source,
  166.             Drop   => Drop);
  167.    end Insert;
  168.  
  169.    ----------
  170.    -- Move --
  171.    ----------
  172.  
  173.    procedure Move
  174.      (Source  : in  Wide_String;
  175.       Target  : out Wide_String;
  176.       Drop    : in  Truncation := Error;
  177.       Justify : in  Alignment  := Left;
  178.       Pad     : in  Wide_Character  := Ada.Strings.Wide_Fixed.Pad)
  179.    is
  180.       Sfirst  : constant Integer := Source'First;
  181.       Slast   : constant Integer := Source'Last;
  182.       Slength : constant Integer := Source'Length;
  183.  
  184.       Tfirst  : constant Integer := Target'First;
  185.       Tlast   : constant Integer := Target'Last;
  186.       Tlength : constant Integer := Target'Length;
  187.  
  188.       function Is_Padding (Item : Wide_String) return Boolean;
  189.       --  Determinbe if all characters in Item are pad characters
  190.  
  191.       function Is_Padding (Item : Wide_String) return Boolean is
  192.       begin
  193.          for J in Item'Range loop
  194.             if Item (J) /= Pad then
  195.                return False;
  196.             end if;
  197.          end loop;
  198.  
  199.          return True;
  200.       end Is_Padding;
  201.  
  202.    --  Start of processing for Move
  203.  
  204.    begin
  205.       if Slength = Tlength then
  206.          Target := Source;
  207.  
  208.       elsif Slength > Tlength then
  209.  
  210.          case Drop is
  211.             when Left =>
  212.                Target := Source (Slast - Tlength + 1 .. Slast);
  213.  
  214.             when Right =>
  215.                Target := Source (Sfirst .. Sfirst + Tlength - 1);
  216.  
  217.             when Error =>
  218.                case Justify is
  219.                   when Left =>
  220.                      if Is_Padding (Source (Sfirst + Tlength .. Slast)) then
  221.                         Target :=
  222.                           Source (Sfirst .. Sfirst + Target'Length - 1);
  223.                      else
  224.                         raise Length_Error;
  225.                      end if;
  226.  
  227.                   when Right =>
  228.                      if Is_Padding (Source (Sfirst .. Slast - Tlength)) then
  229.                         Target := Source (Slast - Tlength + 1 .. Slast);
  230.                      else
  231.                         raise Length_Error;
  232.                      end if;
  233.  
  234.                   when Center =>
  235.                      raise Length_Error;
  236.                end case;
  237.  
  238.          end case;
  239.  
  240.       else -- Source'Length < Target'Length
  241.  
  242.          case Justify is
  243.             when Left =>
  244.                Target (Tfirst .. Tfirst + Slength - 1) := Source;
  245.  
  246.                for I in Tfirst + Slength .. Tlast loop
  247.                   Target (I) := Pad;
  248.                end loop;
  249.  
  250.             when Right =>
  251.                for I in Tfirst .. Tlast - Slength loop
  252.                   Target (I) := Pad;
  253.                end loop;
  254.  
  255.                Target (Tlast - Slength + 1 .. Tlast) := Source;
  256.  
  257.             when Center =>
  258.                declare
  259.                   Front_Pad   : constant Integer := (Tlength - Slength) / 2;
  260.                   Tfirst_Fpad : constant Integer := Tfirst + Front_Pad;
  261.  
  262.                begin
  263.                   for I in Tfirst .. Tfirst_Fpad - 1 loop
  264.                      Target (I) := Pad;
  265.                   end loop;
  266.  
  267.                   Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source;
  268.  
  269.                   for I in Tfirst_Fpad + Slength .. Tlast loop
  270.                      Target (I) := Pad;
  271.                   end loop;
  272.                end;
  273.          end case;
  274.       end if;
  275.    end Move;
  276.  
  277.    ---------------
  278.    -- Overwrite --
  279.    ---------------
  280.  
  281.    function Overwrite
  282.      (Source   : in Wide_String;
  283.       Position : in Positive;
  284.       New_Item : in Wide_String)
  285.       return     Wide_String
  286.    is
  287.    begin
  288.       if Position not in Source'First .. Source'Last + 1 then
  289.          raise Index_Error;
  290.       end if;
  291.  
  292.       declare
  293.          Result_Length : Natural :=
  294.            Natural'Max (Source'Length,
  295.                         Position - Source'First + New_Item'Length);
  296.          Result : Wide_String (1 .. Result_Length);
  297.  
  298.       begin
  299.          Result := Source (Source'First .. Position - 1) & New_Item &
  300.                    Source (Position + New_Item'Length .. Source'Last);
  301.          return Result;
  302.       end;
  303.    end Overwrite;
  304.  
  305.    procedure Overwrite
  306.      (Source   : in out Wide_String;
  307.       Position : in Positive;
  308.       New_Item : in Wide_String;
  309.       Drop     : in Truncation := Right)
  310.    is
  311.    begin
  312.       Move (Source => Overwrite (Source, Position, New_Item),
  313.             Target => Source,
  314.             Drop   => Drop);
  315.    end Overwrite;
  316.  
  317.    -------------------
  318.    -- Replace_Slice --
  319.    -------------------
  320.  
  321.    function Replace_Slice
  322.      (Source   : in Wide_String;
  323.       Low      : in Positive;
  324.       High     : in Natural;
  325.       By       : in Wide_String)
  326.       return     Wide_String
  327.    is
  328.       Result_Length : Natural;
  329.  
  330.    begin
  331.       if Low > Source'Last + 1 or High < Source'First - 1 then
  332.          raise Index_Error;
  333.       end if;
  334.  
  335.       Result_Length :=
  336.         Source'Length - Natural'Max (High - Low + 1, 0) + By'Length;
  337.  
  338.       declare
  339.          Result : Wide_String (1 .. Result_Length);
  340.  
  341.       begin
  342.          if High >= Low then
  343.             Result :=
  344.                Source (Source'First .. Low - 1) & By &
  345.                Source (High + 1 .. Source'Last);
  346.          else
  347.             Result := Source (Source'First .. Low - 1) & By &
  348.                       Source (Low .. Source'Last);
  349.          end if;
  350.          return Result;
  351.       end;
  352.    end Replace_Slice;
  353.  
  354.    procedure Replace_Slice
  355.      (Source   : in out Wide_String;
  356.       Low      : in Positive;
  357.       High     : in Natural;
  358.       By       : in Wide_String;
  359.       Drop     : in Truncation := Error;
  360.       Justify  : in Alignment  := Left;
  361.       Pad      : in Wide_Character  := Wide_Fixed.Pad)
  362.    is
  363.    begin
  364.       Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
  365.    end Replace_Slice;
  366.  
  367.    ----------
  368.    -- Tail --
  369.    ----------
  370.  
  371.    function Tail
  372.      (Source : in Wide_String;
  373.       Count  : in Natural;
  374.       Pad    : in Wide_Character := Wide_Fixed.Pad)
  375.       return   Wide_String
  376.    is
  377.       Result : Wide_String (1 .. Count);
  378.  
  379.    begin
  380.       if Count < Source'Length then
  381.          Result := Source (Source'Last - Count + 1 .. Source'Last);
  382.  
  383.       --  Pad on left
  384.  
  385.       else
  386.          for I in 1 .. Count - Source'Length loop
  387.             Result (I) := Pad;
  388.          end loop;
  389.  
  390.          Result (Count - Source'Length + 1 .. Count) := Source;
  391.       end if;
  392.  
  393.       return Result;
  394.    end Tail;
  395.  
  396.    ---------------
  397.    -- Translate --
  398.    ---------------
  399.  
  400.    function Translate
  401.      (Source  : in Wide_String;
  402.       Mapping : in Wide_Maps.Wide_Character_Mapping)
  403.       return    Wide_String
  404.    is
  405.       Result : Wide_String (1 .. Source'Length);
  406.  
  407.    begin
  408.       for J in Source'Range loop
  409.          Result (J - (Source'First - 1)) := Value (Mapping, Source (J));
  410.       end loop;
  411.  
  412.       return Result;
  413.    end Translate;
  414.  
  415.    procedure Translate
  416.      (Source  : in out Wide_String;
  417.       Mapping : in Wide_Maps.Wide_Character_Mapping)
  418.    is
  419.    begin
  420.       for J in Source'Range loop
  421.          Source (J) := Value (Mapping, Source (J));
  422.       end loop;
  423.    end Translate;
  424.  
  425.    function Translate
  426.      (Source  : in Wide_String;
  427.       Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
  428.       return    Wide_String
  429.    is
  430.       Result : Wide_String (1 .. Source'Length);
  431.  
  432.    begin
  433.       for J in Source'Range loop
  434.          Result (J - (Source'First - 1)) := Mapping (Source (J));
  435.       end loop;
  436.  
  437.       return Result;
  438.    end Translate;
  439.  
  440.    procedure Translate
  441.      (Source  : in out Wide_String;
  442.       Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
  443.    is
  444.    begin
  445.       for I in Source'Range loop
  446.          Source (I) := Mapping (Source (I));
  447.       end loop;
  448.    end Translate;
  449.  
  450.    ----------
  451.    -- Trim --
  452.    ----------
  453.  
  454.    function Trim (Source : in Wide_String) return Wide_String is
  455.       Low, High : Integer;
  456.  
  457.    begin
  458.       Low  := Index_Non_Blank (Source, Forward);
  459.  
  460.       --  All blanks case
  461.  
  462.       if Low = 0 then
  463.          return "";
  464.  
  465.       --  At least one non-blank
  466.  
  467.       else
  468.          High := Index_Non_Blank (Source, Backward);
  469.  
  470.          declare
  471.             Result : Wide_String (1 .. High - Low + 1);
  472.  
  473.          begin
  474.             Result := Source (Low .. High);
  475.             return Result;
  476.          end;
  477.       end if;
  478.    end Trim;
  479.  
  480.    function Trim
  481.       (Source : in Wide_String;
  482.        Left   : in Wide_Maps.Wide_Character_Set;
  483.        Right  : in Wide_Maps.Wide_Character_Set)
  484.        return   Wide_String
  485.    is
  486.       High, Low : Integer;
  487.  
  488.    begin
  489.       Low := Index (Source, Set => Left, Test  => Outside, Going => Forward);
  490.  
  491.       --  Case where source comprises only characters in Left
  492.  
  493.       if Low = 0 then
  494.          return "";
  495.       end if;
  496.  
  497.       High :=
  498.         Index (Source, Set => Right, Test  => Outside, Going => Backward);
  499.  
  500.       --  Case where source comprises only characters in Right
  501.  
  502.       if High = 0 then
  503.          return "";
  504.       end if;
  505.  
  506.       declare
  507.          Result : Wide_String (1 .. High - Low + 1);
  508.  
  509.       begin
  510.          Result := Source (Low .. High);
  511.          return Result;
  512.       end;
  513.    end Trim;
  514.  
  515.    procedure Trim
  516.       (Source  : in out Wide_String;
  517.        Left    : in Wide_Maps.Wide_Character_Set;
  518.        Right   : in Wide_Maps.Wide_Character_Set;
  519.        Justify : in Alignment      := Ada.Strings.Left;
  520.        Pad     : in Wide_Character := Wide_Fixed.Pad)
  521.    is
  522.    begin
  523.       Move (Source  => Trim (Source, Left, Right),
  524.             Target  => Source,
  525.             Justify => Justify,
  526.             Pad     => Pad);
  527.    end Trim;
  528.  
  529. end Ada.Strings.Wide_Fixed;
  530.